perm filename EULER[CRE,BGB] blob
sn#020180 filedate 1973-01-16 generic text, type T, neo UTF8
00100 TITLE EULER - EULER SURFACE PRIMITIVES - JULY 1972 - BGB.
00200 COMMENT/ - MODIFIED FOR CART'S EYE - 1 JANUARY 1973 - BGB.
00300
00400 These primitives preserve the Euler Equation F-E+V = 2*B-2*H;
00500 which was named after Leonhard Euler,1707-1783, Swiss mathematician.
00600
00700 1. INVERT(E); Invert Edge.
00800 2. VNEW ← MKEV(F,V); Make Edge Vertex.
00900 3. ENEW ← MKFE(V1,F,V2); Make Face Edge.
01000 4. VNEW ← ESPLIT(E); Edge Split.
01100
01200 5. F ← KLFE(ENEW); Kill Face Edge.
01300 6. E ← KLEV(VNEW); Kill Edge Vertex.
01400 7. V ← KLVE(ENEW); Kill Vertex Edge.
01500 8. ENEW ← GLUEVV(F1,V1,F2,V2); Glue Vertex Vertex.
01600
01700 -----------------------------------------------------------------/
01800
01900
02000 ;THE EULER PRIMITIVES ARE DEPENDENT ON THE WING OPERATIONS.
02100 EXTERN MKF,MKE,MKV
02200 EXTERN KLF,KLE,KLV
02300 EXTERN WING
02400 EXTERN ECW,ECCW,OTHER,OTHER.
02500 EXTERN BODY,FCW,FCCW,VCW,VCCW
02600
02700
02800 SUBR(INVERT)E-----------------------------------------------------
02900 BEGIN INVERT
03000 LAC 1,ARG1
03100 FOR I⊂(0,1,3,5) {MOVSS I(1)↔}
03200 POP1J
03300 BEND;1/1/73-------------------------------------------------------
00100 SUBR(MKEV)F,V-----------------------------------------------------
00200 BEGIN MKEV;MAKE EDGE VERTEX - BGB - 1 JAN 73.
00300 ACCUMULATORS {VNEW,B,F,V,ENEW,E1,E2}
00400
00500 ;CHECK FOR BAD ARGUMENTS.
00600 CDR VNEW,ARG1;FOR BAD RETURNS.
00700 LAC V,ARG1↔TEST(V,VBIT)↔POP2J
00800 LAC F,ARG2↔TEST(F,FBIT)↔POP2J
00900
01000 ;CREATE A NEW EDGE AND VERTEX.
01100 SETQ(B,{BODY,V})
01200 SETQ(VNEW,{MKV,B})
01300 SETQ(ENEW,{MKE,B})
01400
01500 ;MAKE FACE AND VERTEX LINKS.
01600 PED. ENEW,VNEW
01700 NFACE. F,ENEW
01800 PFACE. F,ENEW
01900 NVT. VNEW,ENEW
02000 PVT. V,ENEW
02100
02200 ;CHECK FOR VERTEX BODY CASE.
02300 PED E1,F↔JUMPE E1,[
02400 PED. ENEW,F↔PED. ENEW,V
02500 PCW. ENEW,ENEW↔NCCW. ENEW,ENEW↔GO .+1]
02600
02700 ;LOWER WINGS POINT AT SELF.
02800 NCW. ENEW,ENEW
02900 PCCW. ENEW,ENEW
03000 ;GET THE UPPER WINGS.
03100 PED E1,V↔LAC E2,E1
03200 NFACE 0,E1↔PFACE 1,E1
03300 CAMN 0,1↔GO L2
03400 L1: LAC E1,E2
03500 SETQ(E2,{ECW,E1,V})
03600 CALL FCW,E1,V
03700 CAME 1,F↔GO L1
03800
03900 ;TIE ENEW TO ITS UPPER WINGS.
04000 L2: PCW. E1,ENEW
04100 NCCW. E2,ENEW
04200 PVT 0,E1↔CAME 0,V↔GO[PCCW. ENEW,E1↔GO .+2]↔NCCW. ENEW,E1
04300 PVT 0,E2↔CAME 0,V↔GO[NCW. ENEW,E2↔GO .+2]↔PCW. ENEW,E2
04400 LAC 1,VNEW
04500 POP2J↔LIT
04600 BEND;1/1/73-------------------------------------------------------
00100 SUBR(MKFE)V1,F,V2-------------------------------------------------
00200 BEGIN MKFE; MAKE FACE EDGE, RETURN NEW EDGE.
00300 ACCUMULATORS{V1,F,V2,FNEW,ENEW,E,E0,B,S12,N}
00400
00500 ;FETCH THE ARGUMENTS.
00600 CDR V1,ARG3
00700 CDR F,ARG2
00800 CDR V2,ARG1
00900
01000 ;DO THE CREATIONS.
01100 DAD B,F
01200 SETQ(FNEW,{MKF,B})
01300 SETQ(ENEW,{MKE,B})
01400
01500 ;LINK ENEW.
01600 PED. ENEW,F↔ PED. ENEW,FNEW
01700 PFACE. F,ENEW↔ NFACE. FNEW,ENEW
01800 PVT. V1,ENEW↔ NVT. V2,ENEW
01900
02000 ;GET THE UPPER WINGS.
02100 PED E,V1↔LAC E0,E↔MOVS 3(E)↔CAME 3(E)
02200 GO[L1: LAC E0,E↔ SETQ(E,{ECW,E0,V1})
02300 CALL(FCW,E0,V1)↔CAME 1,F↔GO L1↔GO .+1]
02400 DAC E0,E1#↔DAC E,E2#
02500
02600 ;GET THE LOWER WINGS.
02700 PED E,V2↔LAC E0,E↔MOVS 3(E)↔CAME 3(E)
02800 GO[L2: LAC E0,E↔ SETQ(E,{ECW,E0,V2})
02900 CALL(FCW,E0,V2)↔CAME 1,F↔GO L2↔GO .+1]
03000 DAC E0,E3#↔DAC E,E4#
03100
03200 COMMENT . MKFE MANDALA
03300
03400 o--------o o--------o
03500 | E2 \ / E1 |
03600 | nccw \ / pcw |
03700 | \ / |
03800 | pvt ⊗ V1 |
03900 | | |
04000 | FNEW ENEW F |
04100 | | |
04200 | nvt ⊗ V2 |
04300 | / \ |
04400 | ncw / \ pccw |
04500 | E3 / \ E4 |
04600 o--------o o--------o
04700
04800 -----------------------------------------------------------------.
00100 ;CDR V2'S TAIL REPLACING +F'S WITH FNEW.
00200 LAC E,E3
00300 L3: MOVS 1,3(E)↔CAME 1,3(E)↔GO L4
00400 PFACE. FNEW,E
00500 PCW E,E↔GO L3
00600
00700 ;CCW FROM V1 REPLACING F'S WITH FNEW.
00800 L4: LAC E0,E↔LAC E,E2
00900 SETZM A#↔CAMN E0,E2↔GO L6
01000 L5: TESTZ E,WASP↔JSR WASPS
01100 NFACE 0,E
01200 CAME F,0
01300 GO[PFACE. FNEW,E↔GO .+2]
01400 NFACE. FNEW,E
01500 CAME E,E0
01600 GO[DAC E,A↔SETQ(E,{ECCW,E,FNEW})↔GO L5]
01700
01800 ;LINK THE WINGS.
01900 L6: CALL WING,E1,ENEW
02000 CALL WING,E2,ENEW
02100 CALL WING,E3,ENEW
02200 CALL WING,E4,ENEW
02300
02400 L7: LAC 1,ENEW
02500 POP3J
02600
02700 WASPS: 0
02800
02900 PCW 1,E↔CAMN 1,A↔GO W1
03000 PCCW 1,E↔CAME 1,A↔GO W2
03100
03200 W1: SETZM A↔MARKZ E,WASP↔PFACE. FNEW,E↔SETQ(E,{ECCW,E,FNEW})
03300 TESTZ E,WASP↔GO W1↔GO @WASPS
03400
03500 W2: SETZM A↔MARKZ E,WASP↔NFACE. FNEW,E↔SETQ(E,{ECCW,E,FNEW})
03600 TESTZ E,WASP↔GO W2↔GO @WASPS
03700
03800 LIT
03900 BEND;1/1/73-------------------------------------------------------
00100 ;VNEW ← ESPLIT(E); "M" COMMAND.
00200 SUBR(ESPLIT)E-----------------------------------------------------
00300 BEGIN ESPLIT
00400 ACCUMULATORS{VNEW,ENEW,B,E,V}
00500
00600 ;CHECK FOR BAD ARGUMENTS.
00700 CDR VNEW,ARG1
00800 LAC E,VNEW
00900 TEST E,EBIT↔GO L
01000 PVT V,E
01100
01200 ;CREATE A NEW EDGE AND VERTEX.
01300 SETQ B,{BODY,E}
01400 SETQ(VNEW,{MKV,B})
01500 SETQ(ENEW,{MKE,B})
01600
01700 ;UPDATE V'S FIRST PTR WHEN NECESSARY.
01800 PED 0,V
01900 CAMN 0,E
02000 PED. ENEW,V
02100
02200 ;PLACE VNEW BETWEEN E AND ENEW.
02300 PED. ENEW,VNEW
02400 PVT 0,E↔PVT. 0,ENEW
02500 PVT. VNEW,E
02600 NVT. VNEW,ENEW
02700 PFACE 0,E↔PFACE. 0,ENEW
02800 NFACE 0,E↔NFACE. 0,ENEW
02900
03000 ;NEW UPPER WINGS ARE LIKE THE OLDE;
03100 PCW 0,E↔CALL WING,0,ENEW
03200 NCCW 0,E↔CALL WING,0,ENEW
03300
03400 ;EDGES POINT AT EACH OTHER ACROSS VNEW.
03500 NCCW. ENEW,E↔PCW. ENEW,E
03600 NCW. E,ENEW↔PCCW. E,ENEW
03700 L: LAC 1,VNEW↔POP1J
03800 BEND;1/1/73-------------------------------------------------------
00100 SUBR(KLFE)ENEW----------------------------------------------------
00200 BEGIN KLFE;KILL FACE EDGE - BGB - 1 JAN 73.
00300
00400 ACCUMULATORS{ENEW,FNEW,V1,V2,E1,E2,E3,E4,E,F}
00500
00600 ;PICK THINGS UP.
00700 CDR ENEW,ARG1
00800 PFACE F,ENEW↔ NFACE FNEW,ENEW
00900 PVT V1,ENEW↔ NVT V2,ENEW
01000
01100 ;GET THE WINGS.
01200 PCW E1,ENEW
01300 NCCW E2,ENEW
01400 NCW E3,ENEW
01500 PCCW E4,ENEW
01600
01700 ;GET RID OF ENEW APPEARANCES IN F & V.
01800 PED 0,V1↔ CAMN 0,ENEW↔ PED. E1,V1
01900 PED 0,V2↔ CAMN 0,ENEW↔ PED. E3,V2
02000 PED 0,F ↔ CAMN 0,ENEW↔ PED. E3,F
02100
02200 ;GET RID OF FNEW APPEARANCES
02300 LAC E,E2
02400 L1: PFACE 0,E↔CAMN 0,FNEW↔GO[PFACE. F,E↔GO L2]
02500 NFACE 0,E↔CAMN 0,FNEW↔GO[NFACE. F,E↔GO L2]
02600 FATAL(KLFE)
02700 L2: CAME E,E3↔GO[SETQ(E,{ECCW,E,F})↔GO L1]
02800
02900 ;LINK WINGS TOGETHER ABOUT F.
03000 CALL WING,E2,E1
03100 CALL WING,E4,E3
03200
03300 ;GET RID OF FNEW AND ENEW.
03400 CALL KLF,FNEW
03500 CALL KLE,ENEW
03600 LAC 1,F↔POP1J
03700
03800 BEND;1/1/73-------------------------------------------------------
00100 SUBR(KLEV)VNEW----------------------------------------------------
00200 BEGIN KLEV;KILL EDGE VERTEX - BGB - 1 JAN 1973.
00300
00400 ACCUMULATORS{E,ENEW,V,VNEW,F}
00500 CDR VNEW,ARG1↔PED ENEW,VNEW
00600 SETQ(E,{ECCW,ENEW,VNEW})
00700 CALL ECCW,E,VNEW↔CAME 1,ENEW
00800 GO[CALL KLFE,1↔GO KLEV]
00900
01000 ;ORIENT EDGES AS IN MANDALA.
01100 NVT 0,ENEW↔ CAMN 0,VNEW↔ GO .+3↔ CALL INVERT,ENEW
01200 PVT 0,E↔ CAMN 0,VNEW↔ GO .+3↔ CALL INVERT,E
01300 ;TIE E TO ITS NEW VERTEX.
01400 PVT V,ENEW↔ PVT. V,E
01500 ;MAKE E'S UPPER WINGS LIKE ENEW'S.
01600 PCW 0,ENEW↔ CALL WING,0,E
01700 NCCW 0,ENEW↔ CALL WING,0,E
01800
01900 ;ELIMINATE OCCURENCES OF ENEW IN F & V.
02000 PED 0,V↔ CAMN 0,ENEW↔ PED. E,V
02100 PFACE F,E↔ PED 0,F↔ CAMN 0,ENEW↔ PED. E,F
02200 NFACE F,E↔ PED 0,F↔ CAMN 0,ENEW↔ PED. E,F
02300 ;PURGE 'EM.
02400 CALL KLV,VNEW
02500 CALL KLE,ENEW
02600 LAC 1,E↔POP1J
02700 LIT
02800 BEND;1/1/73-------------------------------------------------------
02900 COMMENT . \ pvt / KLEV MANDALA
03000 \ /
03100 nccw \ / pcw
03200 \ /
03300 V ⊗
03400 |
03500 ENEW |
03600 | nvt
03700 VNEW ⊗
03800 | pvt
03900 E |
04000 |
04100 ⊗
04200 / \
04300 ncw / \ pccw
04400 / \
04500 / nvt \
04600 -----------------------------------------------------------------.
00100 SUBR(KLVE)ENEW----------------------------------------------------
00200 BEGIN KLVE; V ← KLVE(E) - KILL E & NVT(E) RETURNING PVT(E).
00300 ;BGB - 1 JANUARY 1973.
00400 ACCUMULATORS{A,E,E1,E2,E3,E4,V1,V2,CNT}
00500
00600 ;PICK THINGS UP.
00700 CDR E,ARG1↔NVT V1,E↔PVT V2,E
00800 PCW E1,E↔NCCW E2,E↔NCW E3,E↔PCCW E4,E
00900
01000 ;REPLACE FACE-VERTEX PED'S THAT MIGHT CONTAIN E.
01100 PFACE 1,E↔PED 0,1↔CAMN 0,E↔PED. E1,1
01200 NFACE 1,E↔PED 0,1↔CAMN 0,E↔PED. E2,1
01300 PED 0,V2↔CAMN 0,E↔PED. E2,V2
01400 TESTZ E,WASP↔GO[CALL WING,E1,E2↔CALL WING,E3,E4↔GO L3]
01500
01600 ;REPLACE V1 WITH V2.
01700 LAC A,E3↔LACI CNT,100
01800 L1: PVT 1,A↔CAME 1,V1↔GO[NVT. V2,A↔GO .+2]↔PVT. V2,A
01900 SETQ(A,{ECCW,A,V2})
02000 CAME A,E↔SOJGE CNT,L1↔JUMPL CNT,[FATAL(KLVE-LOOP)]
02100
02200 ;SPLICE WINGS TOGETHER.
02300 CALL WING,E1,E4
02400 CALL WING,E2,E3
02500
02600 ;BURN THE GARBAGE.
02700 CALL KLV,V1
02800 L3: CALL KLE,E
02900 LAC 1,V2
03000 POP1J↔LIT
03100 BEND;1/1/73-------------------------------------------------------
03200 COMMENT . KLVE MANDALA
03300 E2 \ / E1
03400 nccw \ / pcw
03500 \ /
03600 pvt ⊗ V2
03700 |
03800 | E
03900 |
04000 nvt ⊗ V1
04100 / \
04200 ncw / \ pccw
04300 E3 / \ E4
04400 -----------------------------------------------------------------.
00100 SUBR(GLUEVV)F1,V1,F2,V2--------------------------------------------
00200 BEGIN GLUEVV; BGB - 1 JANUARY 1973.
00300 ;ENEW ← GLUEVV(F1,V1,F2,V2) - LIKE TWO MKEV(F,V)'S BACK TO BACK.
00400 Q←←1 ↔ ACCUMULATORS{F1,V1,F2,V2,B,E,E1,E2,E3,E4}
00500 CDR F1,ARG4↔CDR V1,ARG3
00600 CDR F2,ARG2↔CDR V2,ARG1
00700
00800 ;REPLACE F2 WITH F1.
00900 JUMPE F2,[PED E,V2↔GO .+2]↔PED E,F2
01000 DAC E,E0#↔SETQ B,{BODY,E}
01100 L1: PFACE Q,E↔CAMN Q,F2↔PFACE. F1,E
01200 NFACE Q,E↔CAMN Q,F2↔NFACE. F1,E
01300 SETQ(E,{ECCW,E,F1})
01400 CAME E,E0↔GO L1
01500 CALL KLF,F2
01600
01700 ;EDGE CREATION
01800 SETQ(E,{MKE,B})
01900 MARK E,WASP
02000 NFACE. F1,E↔PFACE. F1,E
02100 NVT. V1,E↔PVT. V2,E
02200
02300 ;MAKE WINGS
02400 SETQ(E1,{ECW,V2,F1})↔PCW. E1,E
02500 SETQ(E2,{ECW,E1,V2})↔NCCW. E2,E
02600 SETQ(E3,{ECW,V1,F1})↔NCW. E3,E
02700 SETQ(E4,{ECW,E3,V1})↔PCCW. E4,E
02800
02900 PVT Q,E1↔CAME Q,V2↔GO[PCCW. E,E1↔GO .+2]↔NCCW. E,E1
03000 PVT Q,E2↔CAME Q,V2↔GO[NCW. E,E2↔GO .+2]↔PCW. E,E2
03100 PVT Q,E3↔CAME Q,V1↔GO[PCCW. E,E3↔GO .+2]↔NCCW. E,E3
03200 PVT Q,E4↔CAME Q,V1↔GO[NCW. E,E4↔GO .+2]↔PCW. E,E4
03300
03400 ;MARK WASP WAIST ON POTENTIAL SPUR STARTING AT V1.
03500 CAME E1,E2↔GO L2
03600 MARK E1,WASP↔PVT V1,E1↔PED E1,V1
03700 MOVS Q,1(E1)↔CAMN Q,1(E1)↔GO .-5
03800
03900 L2: LAC Q,E↔CALL INVERT,Q
04000 POP4J↔LIT
04100 BEND;1/1/73-------------------------------------------------------
04200
04300
04400 END
04500 EULER.FAI - EOF.